home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / adacomp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  24.1 KB  |  900 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #include <stdlib.h>
  11. #include <stdio.h>
  12. #include <ctype.h>
  13. #include <string.h>
  14. #ifdef __GNUG__
  15. #define WAITPARM (int*)
  16. #else
  17. #define WAITPARM (union wait*)
  18. #endif
  19. #include "config.h"
  20. #include "adamrgprots.h"
  21. #include "miscprots.h"
  22.  
  23. #ifdef vms
  24. /*  Temporary fix to avoid missing adacomp.h
  25. #define fork vfork
  26. #define unlink delete
  27. #include "adacomp.h"
  28. #include descrip
  29. #include <file.h>
  30. #include <types.h>
  31. #include <stat.h>
  32. */
  33. #else
  34. #include <sys/types.h>
  35. #ifdef IBM_PC
  36. #include <fcntl.h>
  37. #include <process.h>
  38. #else
  39. #include <sys/file.h>
  40. #endif
  41. #endif
  42.  
  43. #ifdef SYSTEM_V
  44. #include <fcntl.h>
  45. #endif
  46. #include <signal.h>
  47.  
  48. #ifdef BSD
  49. #include "time.h"
  50. #include <sys/resource.h>
  51. #endif
  52.  
  53. static int check_status(int, char *, char *);
  54. static char *getsym(char *, char *);
  55. static void arg_dump();
  56. static int run_prog(char *, char **);
  57. static void delete_file(char *);
  58. #ifdef SYSTEM_V
  59. static  int mkdir(char *, int);
  60. #endif
  61. #ifdef vms
  62. static void fold_upper(char *s)                                /*;fold_upper*/
  63. #endif
  64.  
  65. char   *argname;
  66. FILE *MALFILE; /* for use by misc malloc trace */
  67. int     opts_cnt;
  68. char   *other_opts[20];
  69. char   *interface_opts[20];
  70. int     interface_cnt = 0;
  71. int    maxstatus = RC_SUCCESS; /* maximum exit status from called programs */
  72. int     exec_trace = 0;    /* set to print generated command lines */
  73.  
  74. /* names of executables to use if not defined by environment */
  75. #define PRS_NAME "adaprs"
  76. #define SEM_NAME "adasem"
  77. #define GEN_NAME "adagen"
  78. #define BND_NAME "adabind"
  79.  
  80. /* status_get extracts program exit code */
  81. #ifdef IBM_PC
  82. #define status_get(s)        (s)
  83. #define system_status_get(s) (s)
  84. #else
  85. #ifdef vms
  86. #define status_get(s)        (s)
  87. #define system_status_get(s) (s)
  88. #else
  89. #define status_get(s)           ((s)>>8)
  90. #define system_status_get(s) ((s) & 0xff)
  91. #endif
  92. #endif
  93.  
  94. char   *base_name;
  95.  
  96. main(int argc, char **argv)
  97. {
  98.     int     c,fp;
  99.     int     status, ok = TRUE;
  100.     extern int  optind;
  101.     extern char *optarg;
  102. #ifdef vms
  103.     extern char *strjoin(); /* vms only */
  104.     char   *strchr();
  105.     char   *DIRECTORY_START = "[.";
  106. #endif
  107.     char   *PRS, *SEM, *GEN, *BND; 
  108.     char   *arg_name;
  109.     char   *lib_name;
  110.     char   *list_name;
  111.     char   *source_name;
  112.     char   *msg_name;
  113.     char   *tmp_name;
  114.     char   *s_temp;
  115.     char   *l_name;
  116.     char   *basep;
  117.     int       prefix_len, base_len, suffix_len;
  118.     char   *lib_opt_str, *main_unit_name;
  119.     char   *object_files = "";
  120.     char   *sem_options, *gen_options;
  121.     int     bind_opt = 0, main_opt = 0, save_msg_opt = 0 ;
  122.     int     list_opt = FALSE;   /* set to generate a listing */
  123.     char   *list_arg;        /* for passing list_opt to mrg */
  124.     int     lib_opt = FALSE;    /* set to TRUE if -l specified */
  125.     int     newlib_opt = FALSE; /* set to TRUE if -n specified */
  126.     int        time_limit = 15;    /* default time limit in minutes */
  127. #ifdef vms
  128.     char        buffer[50];
  129.     short       rlength;
  130.     struct      dsc$descriptor_s entity_desc;
  131.     struct      dsc$descriptor_s value_desc;
  132.     struct      dsc$descriptor_s string_desc;
  133.     struct      dsc$descriptor_s old_filespec;
  134.     struct      dsc$descriptor_s new_filespec;
  135. #endif
  136. #ifdef BSD
  137.     struct rlimit rlp;
  138. #endif
  139.  
  140. /* initializations */
  141.     arg_name = (char *) 0;
  142.     lib_name = (char *) 0;
  143.     sem_options = "";
  144.     gen_options = "";
  145.  
  146. #ifdef vms
  147.          entity_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  148.          entity_desc.dsc$b_class = DSC$K_CLASS_S;
  149.          value_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  150.          value_desc.dsc$b_class = DSC$K_CLASS_S;
  151.          value_desc.dsc$a_pointer = buffer;
  152.          value_desc.dsc$w_length = 50;
  153.  
  154.          entity_desc.dsc$a_pointer = "VERBOSE";
  155.          entity_desc.dsc$w_length = 7;
  156.          status = CLI$PRESENT(&entity_desc);
  157. #ifdef DEBUG
  158.          printf("VERBOSE status %d\n",status);
  159. #endif
  160.          exec_trace = status & 1;
  161.          if (exec_trace) fprintf(stderr,"Command line: ADACOMP /VERBOSE");
  162.  
  163.          entity_desc.dsc$a_pointer = "ADALINES";
  164.          entity_desc.dsc$w_length = 8;
  165.          status = CLI$PRESENT(&entity_desc);
  166. #ifdef DEBUG
  167.          printf("ADALINES status %d\n",status);
  168. #endif
  169.          if (status & 1) {
  170.              gen_options = strjoin(gen_options,"l");
  171.              if (exec_trace) fprintf(stderr,"/ADALINES");
  172.          }
  173.          
  174.          entity_desc.dsc$a_pointer = "BIND";
  175.          entity_desc.dsc$w_length = 4;
  176.          status = CLI$PRESENT(&entity_desc);
  177. #ifdef DEBUG
  178.          printf("BIND status %d\n",status);
  179. #endif
  180.          bind_opt = (status & 1);
  181.          if (bind_opt && exec_trace) fprintf(stderr,"/BIND");
  182.          
  183.          entity_desc.dsc$a_pointer = "FILE";
  184.          entity_desc.dsc$w_length = 4;
  185.          status = CLI$PRESENT(&entity_desc);
  186. #ifdef DEBUG
  187.          printf("FILE status %d\n",status);
  188. #endif
  189.          if (status & 1) {
  190.              status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  191.              value_desc.dsc$a_pointer[rlength] = '\0';
  192.              arg_name = strjoin(value_desc.dsc$a_pointer,"");
  193.              if (exec_trace) fprintf(stderr," %s ",arg_name);
  194. #ifdef DEBUG
  195.              printf("FILE %s\n", arg_name);
  196. #endif
  197.          }
  198.          
  199.          entity_desc.dsc$a_pointer = "LIBRARY";
  200.          entity_desc.dsc$w_length = 7;
  201.          status = CLI$PRESENT(&entity_desc);
  202. #ifdef DEBUG
  203.          printf("LIBRARY status %d\n",status);
  204. #endif
  205.          lib_opt = status & 1;
  206.          if (lib_opt) {
  207.              status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  208.              value_desc.dsc$a_pointer[rlength] = '\0';
  209.              lib_name = strjoin(value_desc.dsc$a_pointer,"");
  210.              if (exec_trace) fprintf(stderr,"/LIBRARY=%s",lib_name);
  211. #ifdef DEBUG
  212.              printf("LIBRARY %s\n", lib_name);
  213. #endif
  214.          }
  215.          
  216.          entity_desc.dsc$a_pointer = "NEWLIBRARY";
  217.          entity_desc.dsc$w_length = 10;
  218.          status = CLI$PRESENT(&entity_desc);
  219. #ifdef DEBUG
  220.          printf("NEWLIBRARY status %d\n",status);
  221. #endif
  222.          newlib_opt = status & 1;
  223.          if (newlib_opt && exec_trace) fprintf(stderr,"/NEWLIBRARY");
  224.  
  225.          entity_desc.dsc$a_pointer = "LISTING";
  226.          entity_desc.dsc$w_length = 7;
  227.          status = CLI$PRESENT(&entity_desc);
  228. #ifdef DEBUG
  229.          printf("LISTING status %d\n",status);
  230. #endif
  231.          list_opt = status & 1;
  232.          if (list_opt && exec_trace) fprintf(stderr,"/LISTING");
  233.  
  234.          entity_desc.dsc$a_pointer = "MAIN_UNIT";
  235.          entity_desc.dsc$w_length = 9;
  236.          status = CLI$PRESENT(&entity_desc);
  237. #ifdef DEBUG
  238.          printf("MAIN_UNIT status %d\n",status);
  239. #endif
  240.          main_opt = status & 1;
  241.          if (main_opt) {
  242.              status = CLI$GET_VALUE(&entity_desc, &value_desc, &rlength);
  243.              value_desc.dsc$a_pointer[rlength] = '\0';
  244.              main_unit_name = strjoin(value_desc.dsc$a_pointer,"");
  245.              fold_upper(main_unit_name);
  246.              if (exec_trace) fprintf(stderr,"/MAIN_UNIT=%s",main_unit_name);
  247. #ifdef DEBUG
  248.              printf("MAIN_UNIT %s\n", main_unit_name);
  249. #endif
  250.          }
  251.  
  252.          entity_desc.dsc$a_pointer = "MESSAGES";
  253.          entity_desc.dsc$w_length = 8;
  254.          status = CLI$PRESENT(&entity_desc);
  255. #ifdef DEBUG
  256.          printf("MESSAGES status %d\n",status);
  257. #endif
  258.          save_msg_opt = status & 1;
  259.          if (save_msg_opt && exec_trace) fprintf(stderr,"/MESSAGES");
  260.  
  261.          entity_desc.dsc$a_pointer = "MACHINE_CODE";
  262.          entity_desc.dsc$w_length = 12;
  263.          status = CLI$PRESENT(&entity_desc);
  264. #ifdef DEBUG
  265.          printf("MACHINE_CODE status %d\n",status);
  266. #endif
  267.          if (status & 1) {
  268.              gen_options = strjoin(gen_options,"g");
  269.              if (exec_trace) fprintf(stderr,"/MACHINE_CODE");
  270.          }
  271.          if (exec_trace) fprintf(stderr,"\n");
  272.  
  273.          entity_desc.dsc$a_pointer = "PREDEF";
  274.          entity_desc.dsc$w_length = 6;
  275.          status = CLI$PRESENT(&entity_desc);
  276. #ifdef DEBUG
  277.          printf("PREDEF status %d\n",status);
  278. #endif
  279.          if (status & 1) {
  280.              if (exec_trace) fprintf(stderr,"/PREDEF");
  281.          s_temp = emalloc(strlen(sem_options) + 2);
  282.            strcpy(s_temp, sem_options);
  283.              strcat(s_temp, "p");
  284.          sem_options = s_temp;
  285.          s_temp = emalloc(strlen(gen_options) + 2);
  286.          strcpy(s_temp, gen_options);
  287.              strcat(s_temp, "p");
  288.          gen_options = s_temp;
  289.      }
  290. #else
  291. /*
  292.  * command options
  293.  *    -a        generated line number instructions
  294.  *    -b         bind the unit specified by 'm' option
  295.  *    -g        insert generated code into listing
  296.  *      -i              specify object files and libraries for pragma interface
  297.  *    -l libname    (old) library libname
  298.  *    -m main unit      specify the main binding unit.
  299.  *            or use default main unit
  300.  *    -n libname    new library libname
  301.  *      -s        create source program listing
  302.  *    -v        trace executed commands and exit status
  303.  *      -M        save message files (for running B tests)
  304.  *      -P        compile predef
  305.  */
  306.  
  307.     while((c = getopt(argc, argv, "abgl:m:nsvMPi:")) != EOF) {
  308.  
  309.     switch(c) {
  310.         case 'a':
  311.         s_temp = emalloc(strlen(gen_options) + 2);
  312.         strcpy(s_temp, gen_options);
  313.             strcat(s_temp, "l");
  314.         gen_options = s_temp;
  315.         break;
  316.         case 'b':
  317.         bind_opt = 1;
  318.         break;
  319.         case 'g':
  320.         s_temp = emalloc(strlen(gen_options) + 2);
  321.         strcpy(s_temp, gen_options);
  322.             strcat(s_temp, "g");
  323.         gen_options = s_temp;
  324.         break;
  325.         case 'l':
  326.         lib_opt = TRUE;
  327.         lib_name = emalloc(strlen(optarg) + 1);
  328.         strcpy(lib_name, optarg);
  329.         break;
  330.         case 'm':    
  331.         main_opt = 1;
  332.         main_unit_name = emalloc(strlen(optarg) + 1);
  333.         strcpy(main_unit_name, optarg);
  334.         break;
  335.         case 'n':
  336.         newlib_opt = TRUE;
  337.         break;
  338.             case 'i':
  339.         s_temp = emalloc(strlen(optarg) + 1);
  340.         strcpy(s_temp, optarg);
  341.         interface_opts[interface_cnt++] = s_temp;
  342.                 break;
  343.         case 's':
  344.         list_opt++;
  345.         break;
  346.         case 'v':
  347.         exec_trace++;
  348.         break;
  349.         case 'M':
  350.         save_msg_opt = TRUE ;
  351.         break;
  352.         case 'P':
  353.         s_temp = emalloc(strlen(sem_options) + 2);
  354.         strcpy(s_temp, sem_options);
  355.             strcat(s_temp, "p");
  356.         sem_options = s_temp;
  357.         s_temp = emalloc(strlen(gen_options) + 2);
  358.         strcpy(s_temp, gen_options);
  359.             strcat(s_temp, "p");
  360.         gen_options = s_temp;
  361.         break;
  362.         case '?':
  363.         exit(RC_ABORT);
  364.         break;
  365.         default:
  366.         fprintf(stderr, "Unknown Option: %c\n", c);
  367.         exit(RC_ABORT);
  368.     }
  369.     }
  370.     if (optind < argc)
  371.     arg_name = argv[optind];
  372.     if (arg_name == (char *) 0) {
  373.     fprintf(stderr,"Invalid Usage: No ada file specified\n");
  374.     exit(RC_ABORT);
  375.     }
  376. #endif
  377.     if (!lib_opt) { /* if -l not specified, try to get from environment */
  378. #ifdef vms
  379.        lib_name = getenv("ADAEDLIB");
  380. #else
  381.        lib_name = getenv("ADALIB");
  382. #endif
  383.        if (lib_name!=(char *)0) {
  384.        lib_opt++;
  385.     }
  386.     if (lib_opt) {
  387. #ifdef vms
  388.         printf("library defined by ADAEDLIB: %s\n",lib_name);
  389. #else
  390.         printf("library defined by ADALIB: %s\n",lib_name);
  391. #endif
  392.     }
  393.     }
  394.     if (!lib_opt) {
  395. #ifdef vms
  396.        LIB$SIGNAL(MSG_USAGE);
  397. #else
  398.        fprintf(stderr,
  399.         "Invalid Usage: please specify a library\n");
  400.        exit(RC_ABORT);
  401. #endif
  402.     }
  403. #ifdef BSD
  404.     getrlimit(RLIMIT_CPU,&rlp);
  405.     (&rlp)->rlim_cur = time_limit*60;     /* limit to time_limit mins */
  406.     setrlimit(RLIMIT_CPU,&rlp);
  407. #endif
  408.  
  409.     basep = parsefile(arg_name, &prefix_len, &base_len, &suffix_len);
  410.     /* check for presence of ada file;  if none, make it ada */
  411.     if (suffix_len ==0) {
  412.     source_name = emalloc(strlen(arg_name) + 4 + 1);
  413.     strcpy(source_name, arg_name);
  414.     strcat(source_name, ".ada");
  415.     }
  416.     else {
  417.     source_name = arg_name;
  418.     }
  419.     base_name = emalloc(base_len + 1);
  420.     strncpy(base_name, basep, base_len);
  421.     if ((fp = open(source_name,O_RDONLY,0700)) < 0) {
  422. #ifdef vms
  423.         string_desc.dsc$w_length = strlen(source_name);
  424.         string_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  425.         string_desc.dsc$b_class = DSC$K_CLASS_S;
  426.         string_desc.dsc$a_pointer = source_name;
  427.         LIB$SIGNAL(MSG_ADAFILE,1,&string_desc);
  428.         exit();
  429. #else
  430.     fprintf(stderr,"Cannot access file %s\n",source_name);
  431.     exit(RC_ABORT);
  432. #endif
  433.     }
  434.     close(fp);
  435.  
  436.  
  437.     umask(0);
  438.     if (newlib_opt){
  439.         if (exec_trace) {
  440.         fprintf(stderr, "mkdir %s ", lib_name);
  441.         }
  442.         status = mkdir(lib_name, '\377');
  443.         if (exec_trace) {
  444.         fprintf(stderr, " ? %d\n", status);
  445.         }
  446.     }
  447.     status = 0;
  448.     if (status) {
  449. #ifdef vms
  450.         string_desc.dsc$w_length = strlen(lib_name);
  451.         string_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  452.         string_desc.dsc$b_class = DSC$K_CLASS_S;
  453.         string_desc.dsc$a_pointer = lib_name;
  454.         LIB$SIGNAL(MSG_NOLIBRARY,1,&string_desc);
  455.         exit();
  456. #else
  457.         fprintf(stderr,"%s cannot be used as a library\n", lib_name);
  458.         exit(RC_ABORT);
  459. #endif
  460.     }
  461.     if (!newlib_opt) {
  462.         /* check for presence of library file */
  463. #ifdef vms
  464.     l_name = emalloc(strlen(lib_name + strlen(LIBFILENAME) + 4));
  465.         if (strchr(lib_name,'[')) {
  466.        strcpy(l_name, lib_name);
  467.     }
  468.     else {
  469.        strcpy(l_name, DIRECTORY_START);
  470.            strcat(l_name, lib_name);
  471.     }
  472. #else
  473.     l_name = emalloc(strlen(lib_name) + strlen(LIBFILENAME) + 2);
  474.     strcpy(l_name, lib_name);
  475. #endif
  476.  
  477. #ifdef BSD
  478.     strcat(l_name, "/");
  479. #endif
  480. #ifdef SYSTEM_V
  481.     strcat(l_name, "/");
  482. #endif
  483. #ifdef IBM_PC
  484.     strcat(l_name, "/");
  485. #endif
  486. #ifdef vms
  487.         if (!strchr(lib_name,'['))
  488.        strcat(l_name, "]");
  489. #endif
  490.     strcat(l_name, LIBFILENAME);
  491.  
  492.         if ((fp = open(l_name,O_RDONLY,0700)) < 0) {
  493. #ifdef vms
  494.             string_desc.dsc$w_length = strlen(lib_name);
  495.             string_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  496.             string_desc.dsc$b_class = DSC$K_CLASS_S;
  497.             string_desc.dsc$a_pointer = lib_name;
  498.             LIB$SIGNAL(MSG_NOLIBRARY,1,&string_desc);
  499.             exit();
  500. #else
  501.             fprintf(stderr,"%s cannot be used as a library\n", lib_name);
  502.             exit(RC_ABORT);
  503. #endif
  504.         }
  505.     efree(l_name);
  506.         close(fp);
  507.     }
  508.  
  509.     /* format library option as expected by adasem & adagen */
  510.     lib_opt_str = ((newlib_opt) ? "-nl" : "-l");
  511.  
  512.     PRS = getsym("PRS", PRS_NAME);
  513.     other_opts[opts_cnt = 0] = PRS;
  514.     other_opts[++opts_cnt] = lib_opt_str;
  515.     other_opts[++opts_cnt] = lib_name;
  516.     other_opts[++opts_cnt] = source_name;
  517.     other_opts[++opts_cnt] = (char *) 0;
  518.     if (exec_trace)
  519.         arg_dump();
  520.     status = run_prog(PRS, other_opts);
  521.     if (exec_trace)
  522.         fprintf(stderr, " ? %d\n", status);
  523.     ok = check_status(status, "PRS", arg_name);
  524.     if (ok) {
  525.     SEM = getsym("SEM",SEM_NAME);
  526.     other_opts[opts_cnt = 0] = SEM;
  527.     /* check for parsing errors (adaprs exits with RC_ERRORS) */
  528.     if (status_get(status) == RC_ERRORS) {
  529.         s_temp = emalloc(strlen(sem_options) + 2);
  530.         strcpy(s_temp, sem_options);
  531.         strcat(s_temp, "e");
  532.         sem_options = s_temp;
  533.     }
  534.     if (strlen(sem_options) != 0) {
  535.         other_opts[++opts_cnt] = "-s";
  536.         other_opts[++opts_cnt] = sem_options;
  537.     }
  538.     other_opts[++opts_cnt] = lib_opt_str;
  539.     other_opts[++opts_cnt] = lib_name;
  540.     other_opts[++opts_cnt] = base_name;
  541.     other_opts[++opts_cnt] = (char *) 0;
  542.     if (exec_trace)
  543.         arg_dump();
  544.     status = run_prog(SEM, other_opts);
  545.     if (exec_trace)
  546.         fprintf(stderr, " ? %d\n", status);
  547.     ok = check_status(status, "SEM", arg_name);
  548.         /* check for semantic errors (adasem will exit with RC_ERRORS) */
  549.     if (status_get(status)== RC_ERRORS)
  550.         ok = FALSE;
  551.     }
  552.     /* once SEM run, can delete AST file */
  553.     tmp_name = emalloc(strlen(lib_name) + strlen(base_name) + 7);
  554. #ifdef vms
  555.     if (strchr(lib_name,'[')) {
  556.        strcpy(tmp_name, lib_name);
  557.     }
  558.     else {
  559.        strcpy(tmp_name, DIRECTORY_START);
  560.        strcat(tmp_name, lib_name);
  561.     }
  562. #else
  563.     strcpy(tmp_name, lib_name);
  564. #endif
  565.  
  566. #ifdef BSD
  567.     strcat(tmp_name,"/");
  568. #endif
  569. #ifdef SYSTEM_V
  570.     strcat(tmp_name,"/");
  571. #endif
  572. #ifdef IBM_PC
  573.     strcat(tmp_name,"/");
  574. #endif
  575. #ifdef vms
  576.     if (!strchr(lib_name,'[')) 
  577.        strcat(tmp_name,"]");
  578. #endif
  579.     strcat(tmp_name, base_name);
  580.     strcat(tmp_name, ".ast");
  581.     delete_file(tmp_name);
  582.     efree(tmp_name);
  583.     if (ok) {
  584.     GEN = getsym("GEN", GEN_NAME);
  585.     other_opts[opts_cnt = 0] = GEN;
  586.     if (strlen(gen_options) != 0) {
  587.         other_opts[++opts_cnt] = "-g";
  588.         other_opts[++opts_cnt] = gen_options;
  589.     }
  590.     other_opts[++opts_cnt] = lib_opt_str;
  591.     other_opts[++opts_cnt] = lib_name;
  592.     other_opts[++opts_cnt] = base_name;
  593.     other_opts[++opts_cnt] = (char *) 0;
  594.     if (exec_trace)
  595.         arg_dump();
  596.     status =  run_prog(GEN, other_opts);
  597.     if (exec_trace)
  598.         fprintf(stderr, " ? %d\n", status);
  599.     ok = check_status(status, "GEN", arg_name);
  600.     }
  601.     if (ok && bind_opt) { /* run binder if desired */
  602.     BND = getsym("BND", BND_NAME);
  603.     other_opts[opts_cnt = 0] = BND;
  604.     other_opts[++opts_cnt] = "-c"; /* indicate errors in message form */
  605.     other_opts[++opts_cnt] = base_name; /* pass filename for msg listing */
  606.  
  607.     while(interface_cnt) {
  608.         other_opts[++opts_cnt] = "-i";
  609.         other_opts[++opts_cnt] = interface_opts[--interface_cnt];
  610.     }
  611.     if (main_opt) {
  612.         other_opts[++opts_cnt] = "-m";
  613.         other_opts[++opts_cnt] = main_unit_name;
  614.     }
  615.     other_opts[++opts_cnt] = lib_name; /* library is current directory */
  616.     other_opts[++opts_cnt] = (char *) 0;
  617.     if (exec_trace)
  618.         arg_dump();
  619.     status =  run_prog(BND, other_opts);
  620.     if (exec_trace)
  621.         fprintf(stderr, " ? %d\n", status);
  622.     ok = check_status(status, "BND", arg_name);
  623.     }
  624. #ifdef vms
  625. #ifdef SKIP
  626. /* this rename not needed if file generated in proper place
  627.  * ds 1-17-86
  628.  */
  629. struct      dsc$descriptor_s old_filespec;
  630. struct      dsc$descriptor_s new_filespec;
  631.     list_name = strjoin(base_name,".lis;");
  632. /*    tolist_name = strjoin(dir_name, list_name);*/
  633.         old_filespec.dsc$w_length = strlen(list_name);
  634.         old_filespec.dsc$b_dtype = DSC$K_DTYPE_T;
  635.         old_filespec.dsc$b_class = DSC$K_CLASS_S;
  636.         old_filespec.dsc$a_pointer = list_name;
  637.         new_filespec.dsc$w_length = strlen(tolist_name);
  638.         new_filespec.dsc$b_dtype = DSC$K_DTYPE_T;
  639.         new_filespec.dsc$b_class = DSC$K_CLASS_S;
  640.         new_filespec.dsc$a_pointer = tolist_name;
  641.     status = LIB$RENAME_FILE(&old_filespec, &new_filespec);
  642. #endif
  643. #endif
  644. #ifdef IBM_PC
  645.     list_name = emalloc(strlen(base_name) + 4 + 1);
  646.     strcpy(list_name, base_name);
  647.     strcat(list_name, ".lis");
  648. #endif
  649. #ifdef SYSTEM_V
  650.     list_name = emalloc(strlen(base_name) + 4 + 1);
  651.     strcpy(list_name, base_name);
  652.     strcat(list_name, ".lis");
  653. #endif
  654. #ifdef BSD
  655.     list_name = emalloc(strlen(base_name) + 4 + 1);
  656.     strcpy(list_name, base_name);
  657.     strcat(list_name, ".lis");
  658. #endif
  659. #ifdef vms
  660.     list_name = emalloc(strlen(base_name) + 4 + 1);
  661.     strcpy(list_name, base_name);
  662.     strcat(list_name, ".lis");
  663. #endif
  664.     list_arg = (list_opt>0) ? "1" : "0";
  665.     msg_name = emalloc(strlen(lib_name) + strlen(base_name) + 7);
  666. #ifdef vms
  667.     if (strchr(lib_name,'[')) {
  668.        strcpy(msg_name, lib_name);
  669.     }
  670.     else {
  671.        strcpy(msg_name, DIRECTORY_START);
  672.        strcat(msg_name, lib_name);
  673.     }
  674. #else
  675.     strcpy(msg_name, lib_name);
  676. #endif
  677. #ifdef BSD
  678.     strcat(msg_name,"/");
  679. #endif
  680. #ifdef SYSTEM_V
  681.     strcat(msg_name,"/");
  682. #endif
  683. #ifdef IBM_PC
  684.     strcat(msg_name,"/");
  685. #endif
  686. #ifdef vms
  687.     if (!strchr(lib_name,'['))
  688.        strcat(msg_name,"]");
  689. #endif
  690.     strcat(msg_name, base_name);
  691.     strcat(msg_name, ".msg");
  692.     status = mrg(source_name,msg_name, list_name, list_arg);
  693.     efree(list_name);
  694.     if (!save_msg_opt) {
  695.         delete_file(msg_name);
  696.     efree(msg_name);
  697.     }
  698.  
  699. #ifdef vms
  700.     if (maxstatus == RC_ABORT || maxstatus == RC_INTERNAL_ERROR) {
  701.         string_desc.dsc$w_length = strlen(source_name);
  702.         string_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  703.         string_desc.dsc$b_class = DSC$K_CLASS_S;
  704.         string_desc.dsc$a_pointer = source_name;
  705.         LIB$SIGNAL(MSG_ABORT,1,&string_desc);
  706.     }
  707.     exit();
  708. #else
  709.     exit(maxstatus);
  710. #endif
  711. }
  712.  
  713. static char *getsym(char *env_name, char *def_value)        /*;getsym*/
  714. {
  715.   /* Retrieve environment variable designating the executable module for
  716.    * a given phase of the compiler.
  717.    * If the variable is not defined, a default is supplied for BSD systems,
  718.    * whereas on vms execution is aborted!
  719.    */
  720.     char   *s;
  721. #ifdef vms
  722.     struct dsc$descriptor_s phase_desc;
  723. #endif
  724.  
  725.     s = getenv(env_name);
  726.     if (s==(char *)0) {
  727.         char *t = get_libdir();
  728. #ifdef vms
  729.         phase_desc.dsc$w_length = strlen(env_name);
  730.         phase_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  731.         phase_desc.dsc$b_class = DSC$K_CLASS_S;
  732.         phase_desc.dsc$a_pointer = env_name;
  733.         LIB$SIGNAL(MSG_NOENVVAR,1,&phase_desc);
  734.         exit();
  735. #else
  736.         s = emalloc(strlen(t) + strlen(def_value) + 2);
  737.         sprintf(s,"%s/%s", t, def_value);
  738. #endif
  739.     }
  740.     return s;
  741. }
  742.  
  743. static int check_status(int pstatus, char *phase, char *filename)
  744.                                                             /*;check_status*/
  745. {
  746. #ifdef vms
  747.     struct dsc$descriptor_s err_desc ;
  748. #endif
  749.  
  750. #ifdef BSD
  751.     if (system_status_get(pstatus) == SIGXCPU) {
  752.         fprintf(stderr, "Ada/Ed cpu time limit exceeded for %s\n",phase);
  753.         return (FALSE);
  754.     }
  755. #endif
  756.  
  757. #ifdef vms
  758.     /* check for internal compiler error and a signal (system transmitted)
  759.      * that is not IGNORE (1) or BAD_SIGNAL (-1)
  760.      * Check first for user return codes since vms will give precedence
  761.      * toguarantee what will appear user return codes if there was no crash.
  762.      */
  763.     if (status_get(pstatus)  == RC_SUCCESS) {
  764.         return (TRUE);
  765.     }
  766.     if (status_get(pstatus) == RC_ERRORS){
  767.         maxstatus = RC_ERRORS;
  768.         return (TRUE);
  769.     }
  770.     if (status_get(pstatus)  == RC_ABORT) {
  771.         maxstatus = RC_ABORT;
  772.         return (FALSE);
  773.     }
  774.     if ( (status_get(pstatus)  == RC_INTERNAL_ERROR)
  775.       || (system_status_get(pstatus) > 1 && system_status_get(pstatus) < 255)) {
  776.         maxstatus = RC_INTERNAL_ERROR;
  777.         err_desc.dsc$w_length = strlen(phase);
  778.         err_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  779.         err_desc.dsc$b_class = DSC$K_CLASS_S;
  780.         err_desc.dsc$a_pointer = phase;
  781.         LIB$SIGNAL(MSG_BUGCHECK,1,&err_desc);
  782.         return (FALSE);
  783.      }
  784. #else
  785.     /* check for internal compiler error and a signal (system transmitted)
  786.      * that is not IGNORE (1) or BAD_SIGNAL (-1)
  787.      * Check first for crash, since have no guarantee what will appear
  788.      * in 'user' section of return code (status_get field)
  789.      */
  790.     if ( (status_get(pstatus)  == RC_INTERNAL_ERROR)
  791.       || (system_status_get(pstatus) > 1 && system_status_get(pstatus) < 255)) {
  792.         maxstatus = RC_INTERNAL_ERROR;
  793.         fprintf(stderr,"Ada/Ed Internal error(%s) for %s\n", phase, filename);
  794.         return (FALSE);
  795.     }
  796.     if (status_get(pstatus)  == RC_SUCCESS) {
  797.         return (TRUE);
  798.     }
  799.     if (status_get(pstatus) == RC_ERRORS){
  800.         maxstatus = RC_ERRORS;
  801.         return (TRUE);
  802.     }
  803.     if (status_get(pstatus)  == RC_ABORT) {
  804.         maxstatus = RC_ABORT;
  805.         return (FALSE);
  806.     }
  807. #endif
  808. }
  809.  
  810. static void arg_dump()                                            /*;arg_dump*/
  811. {
  812. /*list generated command*/
  813.     int     i;
  814.     fprintf(stderr, "%s ", other_opts[0]);
  815.     for (i = 1; i < opts_cnt; i++) {
  816.         fprintf(stderr, " %s", other_opts[i]);
  817.     }
  818.     fprintf(stderr,"\n");
  819. }
  820.  
  821. static int run_prog(char *prog, char **args)                    /*;run_prog*/
  822. {
  823.     int status;
  824. #ifdef vms
  825.    struct dsc$descriptor_s string_desc;
  826. #endif
  827.  
  828. #ifdef IBM_PC
  829.     status = spawnv(P_WAIT, prog, args);
  830. #else
  831.     if (fork() == 0)
  832. #ifdef vms
  833.         if (execv(prog,other_opts)) {
  834.             string_desc.dsc$w_length = strlen(prog);
  835.             string_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  836.             string_desc.dsc$b_class = DSC$K_CLASS_S;
  837.             string_desc.dsc$a_pointer = prog;
  838.             LIB$SIGNAL(MSG_NOEXECUTE,1,&string_desc);
  839.             exit();
  840.         }
  841. #else
  842.         if (execvp(prog , other_opts)) {
  843.             fprintf(stderr,"cannot execute %s\n", prog);
  844.             exit(RC_ABORT);
  845.         }
  846. #endif
  847.     wait( WAITPARM &status);
  848. #endif
  849.     return status;
  850. }
  851.  
  852. static void delete_file(char *file_name)                    /* ;delete_file */
  853. {
  854.     int status;
  855.  
  856. #ifdef vms
  857.     extern char *strjoin();
  858.  
  859.     file_name = strjoin(file_name,";");
  860. #endif
  861.     status = unlink(file_name);
  862.     if (exec_trace)
  863.         fprintf(stderr,"unlink %s ? %d\n",file_name, status);
  864. }
  865.  
  866. #ifdef SYSTEM_V
  867. #include <sys/stat.h>
  868. /* no mkdir available, mknod doesn't work, so use system */
  869. char syscommand[100];        /* argument for system() call */
  870. static  int mkdir(char *lib_name, int mode)                            /*;mkdir*/
  871. {
  872.     int status;
  873.     struct stat statrec;
  874.  
  875.     if (stat(lib_name,&statrec)) {
  876.        /* stat returns nonzero value if cannot find file. This check
  877.         * is to avoid calling mkdir on an existing directory (since
  878.         * SYSTEM_V complains)
  879.         */
  880.        sprintf(syscommand,"mkdir %s",lib_name);
  881.        system(syscommand);
  882.        return (0);
  883.     }
  884.     else return (-1);
  885. }
  886. #endif
  887.  
  888. #ifdef vms
  889. static void fold_upper(char *s)                                /*;fold_upper*/
  890. {
  891.     char c;
  892.  
  893.     while (*s) {
  894.          c = *s;
  895.     if (islower(c)) *s = toupper(c);
  896.     s++;
  897.     }
  898. }
  899. #endif
  900.